; $Id: example-ma-cli.lisp 14 2014-06-29 22:29:57Z admin@en-circle.com $

; Ant colony example, (paritally) based on 
;  http://ai-depot.com/CollectiveIntelligence/Ant-Colony.html

; Copyright (c) 2014 Peter Vanusanik <admin@en-circle.com>
;
;Permission is hereby granted, free of charge, to any person obtaining a copy
;of this software and associated documentation files (the "Software"), to deal
;in the Software without restriction, including without limitation the rights
;to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;copies of the Software, and to permit persons to whom the Software is
;furnished to do so, subject to the following conditions:
;
;The above copyright notice and this permission notice shall be included in
;all copies or substantial portions of the Software.
;
;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;THE SOFTWARE.

(load "../cl-ass.lisp")

(defenvironment forest
                ((nest :initform (make-instance 'nest) :accessor nest)
                 (food-source :initform (make-instance 'food-source) :accessor food-source)
                 (routes :initform nil :accessor routes)
                 (cities :initform nil :accessor cities)))

(defclass city (storable-class)
  ((type :initform :walkable :reader get-type)
   (nodes :initform nil :accessor nodes)))

(defclass nest (city)
  ((type :initform :colony)))

(defclass food-source (city)
  ((type :initform :food)))

(defclass route (storable-class)
  ((first :accessor first-city)
   (second :accessor second-city)
   (distance :accessor distance)
   (pheromone :accessor pheromone-level)))

(defagent ant
          ((alpha :accessor alpha :initform (- (random 10.0) 5.0))
           (beta :accessor beta :initform (- (random 10.0) 5.0))
           (gamma :accessor gama :initform (- (random 10.0) 5.0))
           (food :initform nil :accessor food-p)
           (to-walk :initform 0 :accessor walk-amount)
           (current-route :initform nil :accessor current-route)
           (source :initform nil :accessor source)
           (traveled-path :initform nil :accessor traveled-path)
           (proud-level :initform 0 :accessor proud-level)
           (return-path :initform nil :accessor return-path)))

(defsimulation ant-civilization 
               ()
               forest
               ())

; Simulation methods
(defmethod initialize-environment ((forest forest) ac)
  (setf (slot-value ac 'agent-list) (loop repeat (+ 5 (random 5)) collect 'ant))
  ; generate random graph
  (let ((check-table (make-hash-table :test 'equal)))
    (setf (cities forest) (append (list (nest forest) (food-source forest))
                                  (loop repeat (+ (random 15) 5) collect (make-instance 'city))))
    (let ((n-cities (- (length (cities forest)) 2)))
      (dotimes (i (+ 3 (random 7)))
        ; Decide number of routes from nest to the food source
        (let ((cnode (nest forest)))
          (dotimes (j (random 8))
            ; up to 8 nodes between nest and food source
            (let ((city (nth (+ 2 (random n-cities)) (cities forest))))
              (unless (or (eq cnode city)
                          (gethash (cons cnode city) check-table)
                          (gethash (cons city cnode) check-table))
                (let ((route (make-instance 'route)))
                  (push route (routes forest))
                  (create-route route cnode city check-table)))
              (setf cnode city))
            ; and put final food source at the end
            (let ((city (food-source forest)))
              (unless (or (eq cnode city)
                          (gethash (cons cnode city) check-table)
                          (gethash (cons city cnode) check-table))
                (let ((route (make-instance 'route)))
                  (push route (routes forest))
                  (create-route route cnode city check-table)))))))
      ; all orphan cities should be connected to at least 2 other cities
      (dolist (city (cddr (cities forest)))
        (unless (nodes city)
          (let ((a city)
                b c)
            (block generate-unused-route
              (loop 
               (setf b (nth (+ 2 (random n-cities)) (cities forest)))
               (setf c (nth (+ 2 (random n-cities)) (cities forest)))
               (unless (or (eq a b) (eq b c) (eq c a))
                 (return-from generate-unused-route))))
            (let ((r1 (make-instance 'route))
                  (r2 (make-instance 'route)))
              (push r1 (routes forest))
              (push r2 (routes forest))
              (create-route r1 b a check-table)
              (create-route r2 a c check-table)))))
      ; randomly connect two cities to make some circles
      (loop repeat (random 10) do
            (let ((cnode (nth (+ 2 (random n-cities)) (cities forest)))
                  (city (nth (+ 2 (random n-cities)) (cities forest))))
              (unless (or (eq cnode city)
                          (gethash (cons cnode city) check-table)
                          (gethash (cons city cnode) check-table))
                (let ((route (make-instance 'route)))
                  (push route (routes forest))
                  (create-route route cnode city check-table))))))))

(defmethod create-route ((route route) a b table)
  (setf (gethash (cons a b) table) t)
  (setf (gethash (cons b a) table) t)
  (setf (first-city route) a)
  (setf (second-city route) b)
  (setf (distance route) (+ 10 (random 150.0) (random 140.0)))
  (setf (pheromone-level route) 30)
  (push route (nodes a))
  (push route (nodes b)))

(defmethod on-iteration-begin ((ac ant-civilization))
  (dolist (route (routes (environment ac)))
    (evaporate route)))

; Route methods
(defmethod evaporate ((route route))
  (setf (pheromone-level route) (max 0 (- (pheromone-level route) 1))))

(defmethod get-other ((route route) city)
  (if (eq city (first-city route))
      (second-city route)
    (first-city route)))

; Ant methods
(defpercept born? ((ant ant) e)
  (not (source ant)))

(defpercept on-route? ((ant ant) e)
  (> (walk-amount ant) 0))

(defpercept having-food? ((ant ant) e)
  (food-p ant))

(defpercept in-food-source? ((ant ant) e)
  (when (source ant)
    (eq (get-type (source ant)) :food)))

(defpercept in-nest? ((ant ant) e)
  (when (source ant)
    (eq (get-type (source ant)) :colony)))

(defactuator graduate-from-ant-school ((ant ant) e)
  (setf (source ant) (nest e)))

(defactuator pick-food ((ant ant) e)
  (setf (food-p ant) t))

(defactuator leave-food ((ant ant) e)
  (setf (food-p ant) nil)
  (setf (traveled-path ant) nil)
  (setf (return-path ant) nil))

(defactuator put-pheromone ((ant ant) e)
  (if (food-p ant) 
      (incf (pheromone-level (first (return-path ant))) 100)
    (incf (pheromone-level (first (traveled-path ant))) 1)))

(defactuator walk ((ant ant) e)
  (setf (walk-amount ant) (max 0 (- (walk-amount ant) 10)))
  (when (= (walk-amount ant) 0)
    (setf (source ant) (get-other (current-route ant) (source ant)))))

(defactuator get-praise-from-queen ((ant ant) e)
  (incf (proud-level ant)))

(defmethod get-tendency ((ant ant) pheromone-level route)
  "If ant has walked thru here already, give it lowest possible tendency, but still possible so he won't cycle"
  (if (member route (traveled-path ant)) 0
    (* (alpha ant) (sin (+ (* (beta ant) pheromone-level) (gama ant))))))

(defmethod choose-route ((agent ant) table)
  (let (max)
    (loop for key being the hash-keys of table do
          (when (or (not max)
                    (> key (car max)))
            (setf max (cons key (gethash key table)))))
    (nth (random (length (cdr max))) (cdr max))))

(defmethod agent-function ((agent ant))
  (with-slots (born? on-route? having-food? in-food-source? in-nest?) agent
    (cond (born? (list 'graduate-from-ant-school))
          (on-route? (list 'walk))
          ((and in-food-source? (not having-food?))
           (list 'put-pheromone 'pick-food))
          ((and in-nest? having-food?)
           (push (current-route agent) (return-path agent))
           (list 'put-pheromone 'leave-food 'get-praise-from-queen))
          (having-food? 
           ; we have food, we are just trying to get home
           (setf (source agent) (get-other (current-route agent) (source agent)))
           (push (current-route agent) (return-path agent))
           (setf (current-route agent) (first (traveled-path agent)))
           (setf (traveled-path agent) (cdr (traveled-path agent)))
           (list 'put-pheromone 'walk))
          (t ; we are in city or in nest without food
           (let ((tendency-container (make-hash-table :test #'=)))
             (dolist (route (remove-if (lambda (route)
                                         (eq route (current-route agent)))
                                       (nodes (source agent))))
               (push route (gethash (get-tendency agent (pheromone-level route) route) tendency-container)))
             (let ((chosen-route (choose-route agent tendency-container)))
               (setf (walk-amount agent) (distance chosen-route))
               (cond ((current-route agent)
                      (push (current-route agent) (traveled-path agent))
                      (setf (current-route agent) chosen-route)
                      (list 'put-pheromone 'walk))
                     (t 
                      (setf (current-route agent) chosen-route)
                      (list 'walk)))))))))

; running
#|
(setf *sim* (make-instance 'ant-civilization))

(initialize-simulation *sim*)
|#